home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 476-500 / disk_499 / diglib / diglib.lzh / source / bargra.for < prev    next >
Text File  |  1991-04-13  |  5KB  |  162 lines
  1.         SUBROUTINE BARGRA(XLOW,XHIGH,NOBARS,IMXPTS,X,
  2.      1                 SXLAB,SYLAB,STITLE,TYPE)
  3.         IMPLICIT NONE
  4. C
  5. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  6. C
  7. C       PROJECT NAME: GRAPHICS UTILITY
  8. C       FILE NAME   : BARGRA.FOR
  9. C       ROUTINE NAME: BARGRA
  10. C       ROUTINE TYPE: SUBROUTINE
  11. C       LANGUAGE    : COMPATIBLE FORTRAN
  12. C
  13. C       VERSION     : 1
  14. C
  15. C       ORIGINAL AUTHOR: JOE P GARBARINI JR
  16. C       DATE           : 02-JUL-82
  17. C
  18. C       MAINTAINER     : HAL R BRAND L126 X26313 (DIGLIB V2 VERSION)
  19. C
  20. C       REVISION: 0
  21. C         REVISION AUTHOR:
  22. C         REVISION DATE  :
  23. C         REVISION NOTES :
  24. C
  25. C       SUMMARY:
  26. C
  27. C               This routine makes a bar graph (frequency graph)
  28. C               from an array of real data.
  29. C
  30. C       INPUT VARIABLES:
  31. C
  32. C               XLOW  : REAL*4 CONSTANT OR VARIABLE.
  33. C                       THE LOW LIMIT FOR THE X-AXIS.
  34. C                       MUST HAVE XLOW <= X(I) FOR ALL I.
  35. C               XHIGH : REAL*4 CONSTANT OR VARIABLE.
  36. C                       THE HIGH LIMIT FOR THE X-AXIS.
  37. C                       MUST HAVE X(I) <= XHIGH FOR ALL I.
  38. C               NOBARS: INTEGER CONSTANT OR VARIABLE.
  39. C                       THE NUMBER OF BARS TO DRAW.
  40. C                       1 <= *NOBARS* <= 200
  41. C                       SEE LOCAL VARIABLE *IMXC*.
  42. C               IMXPTS: INTEGER CONSTANT OR VARIABLE.
  43. C                       THE DIMESION OF ARRAY *X*.
  44. C               X     : REAL*4 VARIABLE.
  45. C                       THE ARRAY OF REAL DATA TO GRAPH.
  46. C               SXLAB : LOGICAL*1 CONSTANT OR VARIABLE.
  47. C                       THE X-AXIS LABLE.
  48. C               SYLAB : LOGICAL*1 CONSTANT OR VARIABLE.
  49. C                       THE Y-AXIS LABLE.
  50. C               STITLE: LOGICAL*1 CONSTANT OR VARIABLE.
  51. C                       THE TITLE.
  52. C               TYPE  : INTEGER CONSTANT OR VARIABLE.
  53. C                       THE AXIS FLAG.  SEE *DIGLIB* DOCUMENTATION.
  54. C
  55. C       OUTPUT VARIABLES: NONE
  56. C
  57. C       INOUT VARIABLES: NONE
  58. C
  59. C       COMMON VARIABLES: NONE
  60. C
  61. C       LOCAL VARIABLES: SEE CODE.
  62. C
  63. C       EXCEPTION HANDLING: NONE
  64. C
  65. C       SIDE EFFECTS: NONE
  66. C
  67. C       PROGRAMMING NOTES:
  68. C
  69. C               This routine does all the calls to DIGLIB necessary
  70. C               to do the plot EXCEPT for a call to DEVSEL.  This
  71. C               way the calling program can choose the device.
  72. C
  73. C               DIGLIB's MAPIT routine uses its own rules for the
  74. C               actual lowest and highest values on the axes.  They
  75. C               always include the users values.  If you wish to move
  76. C               the bar graph away from the left and/or (imaginary) right
  77. C               y axis do the following:
  78. C
  79. C               Let S = (XH - XL) / NOBARS where XH = max X(i)
  80. C               and XL = min X(i).  Now set XLOW = XL - N * S
  81. C               XHIGH = XH + M * S where N,M are chosen at your discretion.
  82. C
  83. C               MAKE SURE THAT XLOW <= X(I) <= XHIGH FOR ALL I.
  84. C
  85. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  86. C
  87.         INTEGER IMXPTS,NOBARS,TYPE
  88.         REAL*4    XLOW,XHIGH
  89.         REAL*4  X(IMXPTS)
  90.         LOGICAL SXLAB(20),SYLAB(20),STITLE(20)
  91. C
  92.         INTEGER I,J,IMXC
  93.         REAL*4    COUNT(512),STEP,FBAR,YLOW,YHIGH,X0,Y0,VX0,VX1
  94.         REAL*4    VY0,VY1,FIMX
  95. C
  96.         IMXC   = 512
  97.         YLOW   = 0.0
  98.         YHIGH  = 1.0
  99.         FBAR   = FLOAT(NOBARS)
  100. C
  101.         IF (XLOW .GE. XHIGH) GOTO 9999
  102.         IF (NOBARS .GT. IMXC) GOTO 9999
  103. C
  104.         STEP   = (XHIGH - XLOW) / FBAR
  105. C
  106.         DO 100 I = 1,NOBARS
  107. C
  108.             COUNT(I) = 0.0
  109. C
  110.  100    CONTINUE
  111. C
  112.         DO 200 I = 1,IMXPTS
  113. C
  114.             J      = INT((X(I)-XLOW)/STEP) + 1
  115.             IF (J .GT. NOBARS) J = NOBARS
  116.             COUNT(J) = COUNT(J) + 1.0
  117. C
  118.  200    CONTINUE
  119. C
  120.         FIMX   = FLOAT(IMXPTS) * STEP
  121. C
  122.         DO 300 I = 1,NOBARS
  123. C
  124.             COUNT(I) = COUNT(I) / FIMX
  125. C
  126.  300    CONTINUE
  127. C
  128.         CALL MINMAX(COUNT,NOBARS,YLOW,YHIGH)
  129.         YLOW   = 0.0
  130.         YHIGH  = YHIGH + 0.1 * YHIGH
  131. C
  132.         CALL BGNPLT
  133.         CALL MAPSIZ(0.0,100.0,0.0,90.0,0.0)
  134.         CALL MAPIT(XLOW,XHIGH,YLOW,YHIGH,SXLAB,SYLAB,STITLE,TYPE)
  135. C
  136.         X0     = XLOW
  137.         Y0     = 0.0
  138.         CALL SCALE(X0,Y0,VX0,VY0)
  139.         CALL GSMOVE(VX0,VY0)
  140. C
  141.         DO 400 I = 1,NOBARS
  142. C
  143.             X0     = XLOW + I * STEP
  144.             Y0     = COUNT(I)
  145.             CALL SCALE(X0,Y0,VX1,VY1)
  146.             CALL GSDRAW(VX0,VY1)
  147.             CALL GSDRAW(VX1,VY1)
  148.             CALL GSDRAW(VX1,VY0)
  149. C
  150.             VX0    = VX1
  151. C
  152.  400    CONTINUE
  153. C
  154.         CALL ENDPLT
  155. C
  156.  9999   CONTINUE
  157. C
  158. C       BYE
  159. C
  160.         RETURN
  161.         END
  162.